home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 26.zip / BS1 part 26 / Powervisor v1.10b disk1.adf / s / pv / assem.pv next >
Text File  |  1991-09-28  |  32KB  |  1,431 lines
  1. /*=======================================================*/
  2. /*                                                                            */
  3. /* Simple assembler for PowerVisor        V1.0                    */
  4. /*                                                                            */
  5. /* © Jorrit Tyberghein  18 Sep 1991                                */
  6. /*                                                                            */
  7. /*=======================================================*/
  8.  
  9. /* Usage : execute this script after setting the start address in the 'rc'
  10.               variable (use 'rx' to call this script)
  11.               Press enter to stop the assembler
  12.  
  13.     This assembler assembles the following commands :
  14.  
  15.         move (with movea)
  16.         moveq
  17.         movem
  18.         tst
  19.         add
  20.         sub
  21.         or
  22.         eor
  23.         and
  24.         addi
  25.         subi
  26.         eori
  27.         ori
  28.         andi
  29.         addq
  30.         subq
  31.         not
  32.         nop
  33.         neg
  34.         swap
  35.         illegal
  36.         reset
  37.         rts
  38.         bra
  39.         bsr
  40.         jmp
  41.         jsr
  42.         b<condition>
  43.         negx
  44.         clr
  45.         cmp
  46.         cmpi
  47.         cmpa
  48.         cmpm
  49.         db<condition>
  50.         dbra
  51.         lea
  52.         pea
  53.         dc (only .W and .L)
  54.  
  55.  
  56.     Almost all 68030 addressing modes are supported. Note that you can
  57.     use PowerVisor expressions almost everywhere where a number is
  58.     expected. But don't make these expressions to complex or the parser
  59.     in this assembler will get confused.
  60.                 xxx    number
  61.                 d16    16 bit displacement
  62.                 d8        8 bit displacement
  63.                 bd        base displacement
  64.                 od        outer displacement
  65.                 An        address register
  66.                 Dn        data register
  67.                 Xn        data or address register
  68.                 PC        program counter
  69.  
  70.                 Note that you can append a size specifier (.W or .L) to Xn
  71.                 and a scale factor (*1 2 4 8)
  72.  
  73.         #<data>
  74.         (xxx).W
  75.         (xxx).L
  76.         (d16,PC)
  77.         (d8,PC,Xn)
  78.         (bd,PC,Xn)
  79.         ([bd,PC,Xn],od)
  80.         ([bd,PC],Xn,od)
  81.         (d16,An)
  82.         (d8,An,Xn)
  83.         (bd,An,Xn)
  84.         ([bd,An,Xn],od)
  85.         ([bd,An],Xn,od)
  86.         (An)+
  87.         -(An)
  88.         (An)
  89.         An
  90.         Dn
  91.  
  92.  
  93.     Instead of a machinelanguage command you can also use dot commands. Start
  94.     the following commands with a dot :
  95.  
  96.         b            goto previous instruction
  97.         pc            set new program counter
  98.         q            quit assembler (same as empty line)
  99.         h            for dot command help
  100.         to            toggle old mode
  101.         tc            toggle commandline mode
  102.         c            copy current instruction to cmdline
  103.         s            skip the current instruction (only in old or cmd mode)
  104.         cc            copy current instruction to buffer
  105.         gc            copy buffer to cmdline
  106.  
  107.  
  108.     Warning ! This assembler also assembles instructions even if there is
  109.     no meaningfull interpretation. For example, you can assemble :
  110.  
  111.         move.l #1,#2
  112.  
  113.  
  114.     Warning ! When the assembler is stopped because of an internal error
  115.     (this can occur when your expressions are too complex), it looks as
  116.     if PowerVisor hangs. Type the following command on the CLI to get
  117.     PowerVisor back in control :
  118.  
  119.         rx "address rexx_powervisor async"
  120.  
  121. */
  122.  
  123.  
  124. options results
  125.  
  126. /* The following assignments are the default modes. You can change the defaults */
  127. /* if you want */
  128. oldmode=1    /* Old mode, when true we display old instruction on screen */
  129. cmdmode=0    /* Cmd mode, when true we copy old instruction to string gadget */
  130.  
  131. 'sync'        /* Disable the PowerVisor commandline. We take control */
  132. 'void rc'    /* 'rc' contains address to start assembling, copy to ARexx variable */
  133. pc=result    /* 'pc' always contains the current program counter */
  134. oldpc=0        /* The previous program counter (used by the .B command) */
  135.  
  136. tmpcmd=0        /* Used by the .C command to temporary set cmdmode to true */
  137. buffer=''    /* Empty buffer */
  138.  
  139. 'void getcol(getlwin())'
  140. col=result    /* Number of columns on PowerVisor default logical window */
  141.  
  142.  
  143. /*-----------*/
  144. /* Main loop */
  145. /*-----------*/
  146.  
  147. do forever
  148.     'print "\('pc',%08lx) : "'        /* Print current address (program counter) */
  149.     'getx'                                /* Get coordinates on screen after address */
  150.     x=result
  151.     'gety'
  152.     y=result
  153.  
  154.     /*** If oldmode or cmdmode =1 we need the disassembly of the old instruction ***/
  155.     if (oldmode=1) | (cmdmode=1) | (tmpcmd>=1) then
  156.         do
  157.             'assign _mem=alloc(n,120)'
  158.             'pvcall 64 _mem' pc '0'    /* Disassemble */
  159.             isize=result                /* Result is size of old instruction */
  160.             'string _mem'                /* Copy string to ARexx */
  161.             oldasmstr=result
  162.             'free _mem'
  163.         end
  164.  
  165.     if oldmode=1 then                    /* We must show the old instruction */
  166.         do
  167.             'locate' x y
  168.             'print "'oldasmstr
  169.         end
  170.  
  171.     if tmpcmd=2 then 'void {pv 10 "'buffer'";scan *"INST"}'
  172.     else if (cmdmode=1) | (tmpcmd=1) then 'void {pv 10 "'oldasmstr'";scan *"INST"}'
  173.     else 'void {scan *"INST"}'
  174.     tmpcmd=0
  175.  
  176.     'string input'                        /* Get new instruction string (or dot command) */
  177.     asmstr=result
  178.  
  179.     'locate' x y                        /* Clear line after program counter */
  180.     'print "'copies(' ',col-x-1)'"'
  181.     'locate' x y                        /* Print instruction or dot command */
  182.     'print "'asmstr
  183.  
  184.     /*** First check if it is a dot command ***/
  185.     if substr(asmstr,1,1)='.' then
  186.         do
  187.             parse upper var asmstr '.' dotcmd args
  188.             if dotcmd='Q' then
  189.                 do
  190.                     'print \0a'
  191.                     'async'
  192.                     exit
  193.                 end
  194.             else if dotcmd='PC' then
  195.                 do
  196.                     'void' args
  197.                     if rc~=0 then 'print "\0aBad expression for programcounter !"'
  198.                     else
  199.                         do
  200.                             if (result=0) | (result%1=1) then
  201.                                 'print "\0aBad expression for programcounter !"'
  202.                             else pc=result
  203.                         end
  204.                 end
  205.             else if dotcmd='B' then
  206.                 do
  207.                     if oldpc=0 then
  208.                         'print "\0aNo previous program counter !"'
  209.                     else
  210.                         do
  211.                             pc=oldpc
  212.                             oldpc=0
  213.                         end
  214.                 end
  215.             else if dotcmd='GC' then tmpcmd=2
  216.             else if dotcmd='CC' then
  217.                 do
  218.                     'assign _mem=alloc(n,120)'
  219.                     'pvcall 64 _mem' pc '0'    /* Disassemble */
  220.                     isize=result                /* Result is size of old instruction */
  221.                     'string _mem'                /* Copy string to ARexx */
  222.                     buffer=result
  223.                     'free _mem'
  224.                 end
  225.             else if dotcmd='TO' then oldmode=1-oldmode
  226.             else if dotcmd='TC' then cmdmode=1-cmdmode
  227.             else if dotcmd='C' then tmpcmd=1
  228.             else if dotcmd='S' then
  229.                 do
  230.                     if (oldmode=1) | (cmdmode=1) then
  231.                         do
  232.                             pc=pc+isize
  233.                             'locate' x y
  234.                             'print "'oldasmstr
  235.                         end
  236.                     else 'print "\0aOnly use .s in <old mode> or <cmd mode> !"'
  237.                 end
  238.             else if dotcmd='H' then
  239.                 do
  240.                     'print "\0aMini Assembler V1.0\0a\0a"'
  241.                     'print ".b    goto previous instruction (only once)\0a"'
  242.                     'print ".pc   set new program counter\0a"'
  243.                     'print ".to   toggle <old mode> (ON/off)\0a"'
  244.                     'print ".tc   toggle <cmdline mode> (on/OFF)\0a"'
  245.                     'print ".c    copy current instruction to commandline\0a"'
  246.                     'print ".s    skip this instruction (in old or cmd mode)\0a"'
  247.                     'print ".cc   copy current instruction to buffer\0a"'
  248.                     'print ".gc   copy buffer to commandline\0a"'
  249.                     'print ".q    quit assembler (same as empty line)\0a"'
  250.                     'print ".h    this help\0a"'
  251.                 end
  252.             else 'print "\0aUnknown dot command (type .H for help) !"'
  253.             'print \0a'
  254.         end
  255.     /*** Else it could be an empty string (equivalent to .Q) ***/
  256.     else if asmstr='' then
  257.         do
  258.             'print \0a'
  259.             'async'
  260.             exit
  261.         end
  262.     /*** Else it should be a valid instruction ***/
  263.     else
  264.         do
  265.             'print \0a'
  266.             oldpc=pc
  267.             a=Assemble(asmstr)
  268.         end
  269. end
  270.  
  271.  
  272.  
  273. /*-----------------------------*/
  274. /* Assemble a string to memory */
  275. /*                                         */
  276. /* Input   : string                 */
  277. /* Uses    : pc                     */
  278. /* Changes : pc                     */
  279. /* Returns : 0 if error or 1     */
  280. /*-----------------------------*/
  281.  
  282. Assemble: procedure expose pc
  283. parse upper arg asmstr
  284.  
  285. parse var asmstr cmd arg
  286. cmd=strip(cmd)
  287. arg=strip(arg)
  288.  
  289. parse var cmd opcode '.' size
  290.  
  291. extra=0
  292.  
  293. if opcode='MOVE' then
  294.     do
  295.         call SplitArgs arg
  296.  
  297.         if source='CCR' then
  298.             do
  299.                 mdest=ModeBits(dest)
  300.                 if mdest=-1 then return 0
  301.                 code=x2d('42c0')
  302.                 arb=ArgRegBits(mdest'|'dest)
  303.                 if arb=-1 then return 0
  304.                 code=code+mdest*8+arb
  305.                 call PushWord code
  306.                 extwrd=extra
  307.                 if GetArg(mdest'|'dest'|W')=-1 then return 0
  308.             end
  309.         else if dest='CCR' then
  310.             do
  311.                 msource=ModeBits(source)
  312.                 if msource=-1 then return 0
  313.                 code=x2d('44c0')
  314.                 arb=ArgRegBits(msource'|'source)
  315.                 if arb=-1 then return 0
  316.                 code=code+msource*8+arb
  317.                 call PushWord code
  318.                 extwrd=extra
  319.                 if GetArg(msource'|'source'|W')=-1 then return 0
  320.             end
  321.         else if source='SR' then
  322.             do
  323.                 mdest=ModeBits(dest)
  324.                 if mdest=-1 then return 0
  325.                 code=x2d('40c0')
  326.                 arb=ArgRegBits(mdest'|'dest)
  327.                 if arb=-1 then return 0
  328.                 code=code+mdest*8+arb
  329.                 call PushWord code
  330.                 extwrd=extra
  331.                 if GetArg(mdest'|'dest'|W')=-1 then return 0
  332.             end
  333.         else if dest='SR' then
  334.             do
  335.                 msource=ModeBits(source)
  336.                 if msource=-1 then return 0
  337.                 code=x2d('46c0')
  338.                 arb=ArgRegBits(msource'|'source)
  339.                 if arb=-1 then return 0
  340.                 code=code+msource*8+arb
  341.                 call PushWord code
  342.                 extwrd=extra
  343.                 if GetArg(msource'|'source'|W')=-1 then return 0
  344.             end
  345.         else if source='USP' then
  346.             do
  347.                 if substr(dest,1,1)~='A' then
  348.                     do
  349.                         'print "Only address register allowed !\0a"'
  350.                         return 0
  351.                     end
  352.                 rb=RegBits(dest)
  353.                 if rb=-1 then return 0
  354.                 code=x2d('4e68')+rb
  355.                 call PushWord code
  356.             end
  357.         else if dest='USP' then
  358.             do
  359.                 if substr(source,1,1)~='A' then
  360.                     do
  361.                         'print "Only address register allowed !\0a"'
  362.                         return 0
  363.                     end
  364.                 rb=RegBits(source)
  365.                 if rb=-1 then return 0
  366.                 code=x2d('4e60')+rb
  367.                 call PushWord code
  368.             end
  369.         else
  370.             do
  371.                 mdest=ModeBits(dest)
  372.                 if mdest=-1 then return 0
  373.                 msource=ModeBits(source)
  374.                 if msource=-1 then return 0
  375.                 msb=MoveSizeBits(size)
  376.                 if msb=-1 then return 0
  377.                 code=msb*4096+mdest*64+msource*8
  378.                 arb=ArgRegBits(mdest'|'dest)
  379.                 if arb=-1 then return 0
  380.                 code=code+arb*512
  381.                 arb=ArgRegBits(msource'|'source)
  382.                 if arb=-1 then return 0
  383.                 code=code+arb
  384.                 call PushWord code
  385.                 extwrd=extra
  386.                 if GetArg(msource'|'source'|'size)=-1 then return 0
  387.                 extwrd=extwrd+extwrd-extra
  388.                 if GetArg(mdest'|'dest'|'size)=-1 then return 0
  389.             end
  390.     end
  391. else if (substr(opcode,1,1)='B') & (length(opcode)=3) then
  392.     do
  393.         'void' arg
  394.         if rc~=0 then
  395.             do
  396.                 'print "Bad integer !\0a"'
  397.                 return 0
  398.             end
  399.         arg=result
  400.         arg=arg-pc-2
  401.  
  402.         if opcode='BRA' then code=x2d('6000')
  403.         else if opcode='BSR' then code=x2d('6100')
  404.         else
  405.             do
  406.                 p=pos(substr(opcode,2,2),'HI LS CC CS NE EQ VC VS PL MI GE LT GT LE')
  407.                 if p=0 then
  408.                     do
  409.                         'print "Unknown opcode !\0a"'
  410.                         return 0
  411.                     end
  412.                 else code=x2d('6000')+((p-1)/3+2)*256
  413.             end
  414.  
  415.         if (size='B') | (size='S') then call PushWord code+MakeByte(arg)
  416.         else if (size='W') | (size='') then
  417.             do
  418.                 call PushWord code
  419.                 call PushWord arg
  420.             end
  421.         else if size='L' then
  422.             do
  423.                 call PushWord code+255
  424.                 call PushLong arg
  425.             end
  426.     end
  427. else if opcode='RTS' then call PushWord x2d('4e75')
  428. else if opcode='NOP' then call PushWord x2d('4e71')
  429. else if (opcode='TST') | (opcode='CLR') | (opcode='NEG') | (opcode='NEGX') | (opcode='NOT') then
  430.     do
  431.         msource=ModeBits(arg)
  432.         if msource=-1 then return 0
  433.         sb=SizeBits(size)
  434.         if sb=-1 then return 0
  435.         sb=sb*64
  436.         if opcode='TST' then code=x2d('4a00')+sb
  437.         else if opcode='NEG' then code=x2d('4400')+sb
  438.         else if opcode='NEGX' then code=x2d('4000')+sb
  439.         else if opcode='NOT' then code=x2d('4600')+sb
  440.         else code=x2d('4200')+sb
  441.         arb=ArgRegBits(msource'|'arg)
  442.         if arb=-1 then return 0
  443.         code=code+msource*8+arb
  444.         call PushWord code
  445.         extwrd=extra
  446.         if GetArg(msource'|'arg'|'size)=-1 then return 0
  447.     end
  448. else if (opcode='ADD') | (opcode='SUB') | (opcode='AND') | (opcode='OR') then
  449.     do
  450.         call SplitArgs arg
  451.         if opcode='ADD' then firstnib=x2d('d000')
  452.         else if opcode='SUB' then firstnib=x2d('9000')
  453.         else if opcode='OR' then firstnib=x2d('8000')
  454.         else firstnib=x2d('c000')
  455.  
  456.         if substr(dest,1,1)='D' then
  457.             do
  458.                 sb=SizeBits(size)
  459.                 if sb=-1 then return 0
  460.                 rb=RegBits(dest)
  461.                 if rb=-1 then return 0
  462.                 code=firstnib+rb*512+sb*64
  463.                 dest=source
  464.             end
  465.         else if substr(source,1,1)='D' then
  466.             do
  467.                 sb=SizeBits(size)
  468.                 if sb=-1 then return 0
  469.                 rb=RegBits(source)
  470.                 if rb=-1 then return 0
  471.                 code=firstnib+x2d('0100')+rb*512+sb*64
  472.             end
  473.         else
  474.             do
  475.                 'print "Must have at least one data register !\0a"'
  476.                 return 0
  477.             end
  478.         mdest=ModeBits(dest)
  479.         if mdest=-1 then return 0
  480.         arb=ArgRegBits(mdest'|'dest)
  481.         if arb=-1 then return 0
  482.         code=code+mdest*8+arb
  483.         call PushWord code
  484.         extwrd=extra
  485.         if GetArg(mdest'|'dest'|'size)=-1 then return 0
  486.     end
  487. else if (opcode='ADDA') | (opcode='SUBA') then
  488.     do
  489.         call SplitArgs arg
  490.         if substr(dest,1,1)='A' then
  491.             do
  492.                 s=AddressSizeBits(size)
  493.                 if s=-1 then return 0
  494.                 if opcode='ADD' then firstnib=x2d('d000')
  495.                 else firstnib=x2d('9000')
  496.                 rb=RegBits(dest)
  497.                 if rb=-1 then return 0
  498.                 code=firstnib+rb*512+s*64
  499.                 msource=ModeBits(source)
  500.                 if msource=-1 then return 0
  501.                 arb=ArgRegBits(msource'|'source)
  502.                 if arb=-1 then return 0
  503.                 code=code+msource*8+arb
  504.                 call PushWord code
  505.                 extwrd=extra
  506.                 if GetArg(msource'|'source'|'size)=-1 then return 0
  507.             end
  508.         else
  509.             do
  510.                 'print "ADDA must have a destination address register !\0a"'
  511.                 return 0
  512.             end
  513.     end
  514. else if (opcode='ADDI') | (opcode='SUBI') | (opcode='ADDQ') | (opcode='SUBQ') | (opcode='ANDI') | (opcode='CMPI') | (opcode='EORI') | (opcode='ORI') then
  515.     do
  516.         call SplitArgs arg
  517.         if substr(source,1,1)~='#' then
  518.             do
  519.                 'print "Bad immediate value !\0a"'
  520.                 return 0
  521.             end
  522.  
  523.         parse var source '#' imm
  524.         'void' imm
  525.         if rc~=0 then
  526.             do
  527.                 'print "Bad integer !\0a"'
  528.                 return 0
  529.             end
  530.         imm=result
  531.  
  532.         mdest=ModeBits(dest)
  533.         if mdest=-1 then return 0
  534.         sb=SizeBits(size)
  535.         if sb=-1 then return 0
  536.         arb=ArgRegBits(mdest'|'dest)
  537.         if arb=-1 then return 0
  538.         sb=sb*64+mdest*8+arb
  539.         if opcode='ADDI' then code=x2d('0600')+sb
  540.         else if opcode='SUBI' then code=x2d('0400')+sb
  541.         else if opcode='ANDI' then code=x2d('0200')+sb
  542.         else if opcode='ORI' then code=x2d('0000')+sb
  543.         else if opcode='CMPI' then code=x2d('0c00')+sb
  544.         else if opcode='EORI' then code=x2d('0a00')+sb
  545.         else if opcode='SUBQ' then code=x2d('5100')+sb+imm*512
  546.         else code=x2d('5000')+sb+imm*512
  547.  
  548.         call PushWord code
  549.  
  550.         if substr(opcode,4,1)~='Q' then
  551.             do
  552.                 if size='B' then call PushWord imm
  553.                 else if (size='W') | (size='') then call PushWord imm
  554.                 else call PushLong imm
  555.             end
  556.  
  557.         extwrd=extra
  558.         if GetArg(mdest'|'dest'|'size)=-1 then return 0
  559.     end
  560. else if opcode='CMP' then
  561.     do
  562.         call SplitArgs arg
  563.  
  564.         if substr(dest,1,1)='D' then
  565.             do
  566.                 sb=SizeBits(size)
  567.                 if sb=-1 then return 0
  568.                 rb=RegBits(dest)
  569.                 if rb=-1 then return 0
  570.                 code=x2d('b000')+rb*512+sb*64
  571.             end
  572.         else
  573.             do
  574.                 'print "Destination must be a data register !\0a"'
  575.                 return 0
  576.             end
  577.         msource=ModeBits(source)
  578.         if msource=-1 then return 0
  579.         arb=ArgRegBits(msource'|'source)
  580.         if arb=-1 then return 0
  581.         code=code+msource*8+arb
  582.         call PushWord code
  583.         extwrd=extra
  584.         if GetArg(msource'|'source'|'size)=-1 then return 0
  585.     end
  586. else if opcode='CMPA' then
  587.     do
  588.         call SplitArgs arg
  589.  
  590.         if substr(dest,1,1)='A' then
  591.             do
  592.                 asb=AddressSizeBits(size)
  593.                 if asb=-1 then return 0
  594.                 rb=RegBits(dest)
  595.                 if rb=-1 then return 0
  596.                 code=x2d('b000')+rb*512+asb*64
  597.             end
  598.         else
  599.             do
  600.                 'print "Destination must be an address register !\0a"'
  601.                 return 0
  602.             end
  603.         msource=ModeBits(source)
  604.         if msource=-1 then return 0
  605.         arb=ArgRegBits(msource'|'source)
  606.         if arb=-1 then return 0
  607.         code=code+msource*8+arb
  608.         call PushWord code
  609.         extwrd=extra
  610.         if GetArg(msource'|'source'|'size)=-1 then return 0
  611.     end
  612. else if opcode='CMPM' then
  613.     do
  614.         call SplitArgs arg
  615.  
  616.         parse var source '(A' sreg ')+'
  617.         parse var dest '(A' dreg ')+'
  618.         sreg='A'sreg
  619.         dreg='A'dreg
  620.  
  621.         sb=SizeBits(size)
  622.         if sb=-1 then return 0
  623.         rb=RegBits(sreg)
  624.         if rb=-1 then return 0
  625.         rbd=RegBits(dreg)
  626.         if rbd=-1 then return 0
  627.         code=x2d('b108')+sb*64+rb*512+rbd
  628.         call PushWord code
  629.     end
  630. else if ((substr(opcode,1,2)='DB') & (length(opcode)=4)) | (opcode='DBT') | (opcode='DBF') then
  631.     do
  632.         if opcode='DBT' then code=x2d('50c8')
  633.         else if (opcode='DBF') | (opcode='DBRA') then code=x2d('51c8')
  634.         else
  635.             do
  636.                 p=pos(substr(opcode,3,2),'HI LS CC CS NE EQ VC VS PL MI GE LT GT LE')
  637.                 if p=0 then
  638.                     do
  639.                         'print "Unknown opcode !\0a"'
  640.                         return 0
  641.                     end
  642.                 else code=x2d('50c8')+((p-1)/3+2)*256
  643.             end
  644.  
  645.         call SplitArgs arg
  646.         if substr(source,1,1)~='D' then
  647.             do
  648.                 'print "Count register must be a data register !\0a"'
  649.                 return 0
  650.             end
  651.         rb=RegBits(source)
  652.         if rb=-1 then return 0
  653.         code=code+rb
  654.         call PushWord code
  655.         'void' dest
  656.         if rc~=0 then
  657.             do
  658.                 'print "Bad integer !\0a"'
  659.                 return 0
  660.             end
  661.         dest=result
  662.         dest=dest-pc-2
  663.         call PushWord dest
  664.     end
  665. else if opcode='EOR' then
  666.     do
  667.         call SplitArgs arg
  668.  
  669.         if substr(source,1,1)='D' then
  670.             do
  671.                 sb=SizeBits(size)
  672.                 if sb=-1 then return 0
  673.                 rb=RegBits(source)
  674.                 if rb=-1 then return 0
  675.                 code=x2d('b100')+rb*512+sb*64
  676.             end
  677.         else
  678.             do
  679.                 'print "Source must be a data register !\0a"'
  680.                 return 0
  681.             end
  682.         mdest=ModeBits(dest)
  683.         if mdest=-1 then return 0
  684.         arb=ArgRegBits(mdest'|'dest)
  685.         if arb=-1 then return 0
  686.         code=code+mdest*8+arb
  687.         call PushWord code
  688.         extwrd=extra
  689.         if GetArg(mdest'|'dest'|'size)=-1 then return 0
  690.     end
  691. else if opcode='ILLEGAL' then call PushWord x2d('4afc')
  692. else if opcode='RESET' then call PushWord x2d('4e70')
  693. else if (opcode='JMP') | (opcode='JSR') then
  694.     do
  695.         if opcode='JMP' then code=x2d('4ec0')
  696.         else code=x2d('4e80')
  697.         marg=ModeBits(arg)
  698.         if marg=-1 then return 0
  699.         arb=ArgRegBits(marg'|'arg)
  700.         if arb=-1 then return 0
  701.         code=code+marg*8+arb
  702.         call PushWord code
  703.         extwrd=extra
  704.         if GetArg(marg'|'arg'|W')=-1 then return 0
  705.     end
  706. else if opcode='LEA' then
  707.     do
  708.         call SplitArgs arg
  709.  
  710.         if substr(dest,1,1)='A' then
  711.             do
  712.                 rb=RegBits(dest)
  713.                 if rb=-1 then return 0
  714.                 code=x2d('41c0')+rb*512
  715.             end
  716.         else
  717.             do
  718.                 'print "Destination must be an address register !\0a"'
  719.                 return 0
  720.             end
  721.         msource=ModeBits(source)
  722.         if msource=-1 then return 0
  723.         arb=ArgRegBits(msource'|'source)
  724.         if arb=-1 then return 0
  725.         code=code+msource*8+arb
  726.         call PushWord code
  727.         extwrd=extra
  728.         if GetArg(msource'|'source'|L')=-1 then return 0
  729.     end
  730. else if opcode='MOVEM' then
  731.     do
  732.         call SplitArgs arg
  733.  
  734.         if (pos('-',source)~=0) | (pos('/',source)~=0) | ((length(source)=2) & (pos(substr(source,1,1),'DA')~=0)) then
  735.             do
  736.                 list=source
  737.                 arg=dest
  738.                 code=x2d('4880')
  739.             end
  740.         else
  741.             do
  742.                 list=dest
  743.                 arg=source
  744.                 code=x2d('4c80')
  745.             end
  746.  
  747.         bits=RegListBits(list)
  748.         if bits=-1 then return 0
  749.         if substr(arg,1,2)~='-(' then bits=reverse(bits)
  750.         rlbits=c2d(b2c(bits))
  751.  
  752.         asb=AddressSizeBits(size)
  753.         if asb=-1 then return 0
  754.         code=code+(asb%4)*64
  755.  
  756.         marg=ModeBits(arg)
  757.         if marg=-1 then return 0
  758.         arb=ArgRegBits(marg'|'arg)
  759.         if arb=-1 then return 0
  760.         code=code+marg*8+arb
  761.         call PushWord code
  762.         call PushWord rlbits
  763.         extwrd=extra
  764.         if GetArg(marg'|'arg'|'size)=-1 then return 0
  765.     end
  766. else if opcode='MOVEQ' then
  767.     do
  768.         call SplitArgs arg
  769.         if substr(source,1,1)~='#' then
  770.             do
  771.                 'print "Bad immediate value !\0a"'
  772.                 return 0
  773.             end
  774.         if substr(dest,1,1)~='D' then
  775.             do
  776.                 'print "Destination must be a data register !\0a"'
  777.                 return 0
  778.             end
  779.  
  780.         parse var source '#' imm
  781.         'void' imm
  782.         if rc~=0 then
  783.             do
  784.                 'print "Bad integer !\0a"'
  785.                 return 0
  786.             end
  787.         imm=result
  788.  
  789.         rb=RegBits(dest)
  790.         if rb=-1 then return 0
  791.         code=x2d('7000')+rb*512+MakeByte(imm)
  792.         call PushWord code
  793.     end
  794. else if opcode='PEA' then
  795.     do
  796.         msource=ModeBits(arg)
  797.         if msource=-1 then return 0
  798.         code=x2d('4840')
  799.         arb=ArgRegBits(msource'|'arg)
  800.         if arb=-1 then return 0
  801.         code=code+msource*8+arb
  802.         call PushWord code
  803.         extwrd=extra
  804.         if GetArg(msource'|'arg'|L')=-1 then return 0
  805.     end
  806. else if opcode='SWAP' then
  807.     do
  808.         if substr(arg,1,1)~='D' then
  809.             do
  810.                 'print "Argument must be a data register !\0a"'
  811.                 return 0
  812.             end
  813.         rb=RegBits(arg)
  814.         if rb=-1 then return 0
  815.         code=x2d('4840')+rb
  816.         call PushWord code
  817.     end
  818. else if opcode='DC' then
  819.     do
  820.         'void' arg
  821.         if rc~=0 then
  822.             do
  823.                 'print "Bad integer !\0a"'
  824.                 return 0
  825.             end
  826.         arg=result
  827.         if size='B' then
  828.             do
  829.                 'print "Sorry DC.B not supported !\0a"'
  830.                 return 0
  831.             end
  832.         if (size='W') | (size='') then call PushWord arg
  833.         else if size='L' then call PushLong arg
  834.         else
  835.             do
  836.                 'print "Bad size specifier !\0a"'
  837.                 return 0
  838.             end
  839.     end
  840. else
  841.     do
  842.         'print "Unknown opcode !\0a"'
  843.         return 0
  844.     end
  845.  
  846. 'assign _m='pc
  847. do j=0 to extra-1
  848.     'assign *(_m+'j'*2).w='c.j
  849. end
  850. pc=pc+extra*2
  851. return 1
  852.  
  853.  
  854. /*-------------------------------*/
  855. /* Convert size specifier for     */
  856. /* MOVE to bits                        */
  857. /*                                            */
  858. /* Input   : size .B, .W, .L        */
  859. /* Uses    :                             */
  860. /* Changes :                             */
  861. /* Returns : -1 if error or bits    */
  862. /*-------------------------------*/
  863.  
  864. MoveSizeBits: procedure
  865. parse arg size
  866.  
  867.     if size='B' then return 1
  868.     else if (size='W') | (size='') then return 3
  869.     else if size='L' then return 2
  870.     else
  871.         do
  872.             'print "Bad size specifier !\0a"'
  873.             return -1
  874.         end
  875.  
  876.  
  877. /*-------------------------------*/
  878. /* Convert size specifier for     */
  879. /* address registers to bits        */
  880. /*                                            */
  881. /* Input   : size .W, .L            */
  882. /* Uses    :                             */
  883. /* Changes :                             */
  884. /* Returns : -1 if error or bits    */
  885. /*-------------------------------*/
  886.  
  887. AddressSizeBits: procedure
  888. parse arg size
  889.  
  890.     if (size='W') | (size='') then return 3
  891.     else if size='L' then return 7
  892.     else
  893.         do
  894.             'print "Bad size specifier !\0a"'
  895.             return -1
  896.         end
  897.  
  898.  
  899. /*-------------------------------*/
  900. /* Convert size specifier            */
  901. /* to bits                                */
  902. /*                                            */
  903. /* Input   : size .B, .W, .L        */
  904. /* Uses    :                             */
  905. /* Changes :                             */
  906. /* Returns : -1 if error or bits    */
  907. /*-------------------------------*/
  908.  
  909. SizeBits: procedure
  910. parse arg size
  911.  
  912.     if size='B' then return 0
  913.     else if (size='W') | (size='') then return 1
  914.     else if size='L' then return 2
  915.     else
  916.         do
  917.             'print "Bad size specifier !\0a"'
  918.             return -1
  919.         end
  920.  
  921.  
  922. /*-------------------------------*/
  923. /* Convert register to bits        */
  924. /*                                            */
  925. /* Input   : reg A0..A7 D0..D7    */
  926. /* Uses    :                             */
  927. /* Changes :                             */
  928. /* Returns : -1 if error or bits    */
  929. /*-------------------------------*/
  930.  
  931. RegBits: procedure
  932. parse arg reg
  933.  
  934.     l=substr(reg,1,1)
  935.     if ((l='D') | (l='A')) & (length(reg)=2) then return substr(reg,2,1)
  936.     else
  937.         do
  938.             'print "Bad register name !\0a"'
  939.             return -1
  940.         end
  941.  
  942.  
  943. /*-------------------------------*/
  944. /* Convert parameter to bits        */
  945. /* corresponding with mode field    */
  946. /* in most instructions                */
  947. /*                                            */
  948. /* Input   : addressing arg        */
  949. /* Uses    :                             */
  950. /* Changes :                             */
  951. /* Returns : -1 if error or bits    */
  952. /*-------------------------------*/
  953.  
  954. ModeBits: procedure
  955. parse arg argum
  956.  
  957.     l=substr(argum,1,1)
  958.     if l='(' then
  959.         do
  960.             if pos('PC',argum) ~= 0 then return 7
  961.             l=substr(argum,2,1)
  962.             if l='A' then
  963.                 do
  964.                     if substr(argum,5,1)='+' then return 3
  965.                     else return 2
  966.                 end
  967.             else
  968.                 do
  969.                     if pos(',',argum)=0 then return 7
  970.                     parse var argum left ',' right
  971.                     if pos(',',right)=0 then return 5
  972.                     else return 6
  973.                 end
  974.         end
  975.     else if l='A' then return 1
  976.     else if l='D' then return 0
  977.     else if l='-' then return 4
  978.     else if l='#' then return 7
  979.     else
  980.         do
  981.             'print "Bad argument format !\0a"'
  982.             return -1
  983.         end
  984.  
  985.  
  986. /*-------------------------------------*/
  987. /* Convert parameter to bits                */
  988. /* corresponding with register            */
  989. /* field in most instructions                */
  990. /* ('mode' in Input is the value            */
  991. /* returned by 'ModeBits')                    */
  992. /*                                                    */
  993. /* Input   : mode '|' addressing arg    */
  994. /* Uses    :                                     */
  995. /* Changes :                                     */
  996. /* Returns : -1 if error or bits            */
  997. /*-------------------------------------*/
  998.  
  999. ArgRegBits: procedure
  1000. parse arg mode '|' argum
  1001.  
  1002.     if (mode=0) | (mode=1) then return RegBits(argum)
  1003.     else if (mode=2) | (mode=3) | (mode=4) then
  1004.         do
  1005.             parse var argum '(A' reg
  1006.             reg=substr(reg,1,1)
  1007.             return RegBits('A'reg)
  1008.         end
  1009.     else if mode~=7 then    /* 5 and 6 */
  1010.         do
  1011.             parse var argum ',A' reg
  1012.             reg=substr(reg,1,1)
  1013.             return RegBits('A'reg)
  1014.         end
  1015.     else
  1016.         do
  1017.             l=substr(argum,1,1)
  1018.             if l='#' then return 4
  1019.             else
  1020.                 do
  1021.                     parse var argum '(' xxx ')' yyy
  1022.                     if yyy='.W' then return 0
  1023.                     else if yyy='.L' then return 1
  1024.                     parse var argum '(' xxx ',' yyy
  1025.                     if yyy='PC)' then return 2
  1026.                     else return 3
  1027.                 end
  1028.         end
  1029.  
  1030.  
  1031. /*-------------------------*/
  1032. /* Push a word to memory    */
  1033. /*                                    */
  1034. /* Input   : word to push    */
  1035. /* Uses    : c. extra        */
  1036. /* Changes : c. extra        */
  1037. /* Returns :                    */
  1038. /*-------------------------*/
  1039.  
  1040. PushWord: procedure expose c. extra
  1041. parse arg word
  1042.  
  1043.     c.extra=MakeWord(word)
  1044.     extra=extra+1
  1045.     return
  1046.  
  1047.  
  1048. /*-------------------------*/
  1049. /* Push a long to memory    */
  1050. /*                                    */
  1051. /* Input   : long to push    */
  1052. /* Uses    : c. extra        */
  1053. /* Changes : c. extra        */
  1054. /* Returns :                    */
  1055. /*-------------------------*/
  1056.  
  1057. PushLong: procedure expose c. extra
  1058. parse arg long
  1059.  
  1060.     c.extra=MakeWord(x2d(left(d2x(long,8),4)))
  1061.     extra=extra+1
  1062.     c.extra=MakeWord(x2d(d2x(long,4)))
  1063.     extra=extra+1
  1064.     return
  1065.  
  1066.  
  1067. /*----------------------------------------------*/
  1068. /* Parse a normal addressing argument                */
  1069. /* and push words to memory                            */
  1070. /*                                                                */
  1071. /* Input   : mode '|' addressing arg '|' size    */
  1072. /* Uses    : c. extra pc extwrd                        */
  1073. /* Changes : c. extra                                    */
  1074. /* Returns : -1 if error or 0                            */
  1075. /*----------------------------------------------*/
  1076.  
  1077. GetArg: procedure expose c. extra pc extwrd
  1078. parse arg mode '|' argum '|' size
  1079.  
  1080.     if (mode=0) | (mode=1) | (mode=2) | (mode=3) | (mode=4) then
  1081.         return 0
  1082.     else if mode=5 then
  1083.         do
  1084.             parse var argum '(' xxx ','
  1085.             'void' xxx
  1086.             if rc~=0 then
  1087.                 do
  1088.                     'print "Bad integer !\0a"'
  1089.                     return -1
  1090.                 end
  1091.             xxx=result
  1092.             if (xxx<=32767) & (xxx>=-32768) then call PushWord xxx
  1093.             else if (xxx<=65535) & (xxx>=0) then call PushWord xxx
  1094.             else
  1095.                 do
  1096.                     'print "Sorry, longword Ax relative not supported !\0a"'
  1097.                     return -1
  1098.                 end
  1099.             return 0
  1100.         end
  1101.     else if mode=7 then
  1102.         do
  1103.             reg=ArgRegBits(mode'|'argum)
  1104.             if reg=-1 then return -1
  1105.             else if reg=0 then
  1106.                 do
  1107.                     parse var argum '(' xxx ')'
  1108.                     'void' xxx
  1109.                     if rc~=0 then
  1110.                         do
  1111.                             'print "Bad integer !\0a"'
  1112.                             return -1
  1113.                         end
  1114.                     call PushWord result
  1115.                     return 0
  1116.                 end
  1117.             else if reg=1 then
  1118.                 do
  1119.                     parse var argum '(' xxx ')'
  1120.                     'void' xxx
  1121.                     if rc~=0 then
  1122.                         do
  1123.                             'print "Bad integer !\0a"'
  1124.                             return -1
  1125.                         end
  1126.                     call PushLong result
  1127.                     return 0
  1128.                 end
  1129.             else if reg=4 then
  1130.                 do
  1131.                     s=MoveSizeBits(size)
  1132.                     if s=-1 then return -1
  1133.                     parse var argum '#' xxx
  1134.                     'void' xxx
  1135.                     if rc~=0 then
  1136.                         do
  1137.                             'print "Bad integer !\0a"'
  1138.                             return -1
  1139.                         end
  1140.                     xxx=result
  1141.                     if s=2 then call PushLong xxx
  1142.                     else call PushWord xxx
  1143.                     return 0
  1144.                 end
  1145.             else if reg=2 then
  1146.                 do
  1147.                     parse var argum '(' xxx ','
  1148.                     'void' xxx
  1149.                     if rc~=0 then
  1150.                         do
  1151.                             'print "Bad integer !\0a"'
  1152.                             return -1
  1153.                         end
  1154.                     xxx=result
  1155.                     xxx=xxx-pc+extwrd*2-4
  1156.  
  1157.                     if (xxx<=32767) & (xxx>=-32768) then call PushWord xxx
  1158.                     else
  1159.                         do
  1160.                             'print "Sorry, longword PC relative not supported !\0a"'
  1161.                             return -1
  1162.                         end
  1163.                     return 0
  1164.                 end
  1165.             else
  1166.                 do
  1167.                     if pos('PC',argum)=0 then
  1168.                         do
  1169.                             'print "Illegal base register !\0a"'
  1170.                             return -1
  1171.                         end
  1172.                     return ParseComplexArg(argum'|PC')
  1173.                 end
  1174.         end
  1175.     else
  1176.         do
  1177.             parse var argum ',A' reg
  1178.             return ParseComplexArg(argum'|A'substr(reg,1,1))
  1179.         end
  1180.     return 0
  1181.  
  1182.  
  1183. /*----------------------------------------------*/
  1184. /* Parse a complex addressing argument                */
  1185. /* and push words to memory                            */
  1186. /*                                                                */
  1187. /* Input   : addressing arg '|' base register    */
  1188. /* Uses    : c. extra pc extwrd                        */
  1189. /* Changes : c. extra                                    */
  1190. /* Returns : -1 if error or 0                            */
  1191. /*----------------------------------------------*/
  1192.  
  1193. ParseComplexArg: procedure expose c. extra pc extwrd
  1194. parse arg argum '|' basereg
  1195.  
  1196.     if substr(argum,2,1)='[' then
  1197.         do
  1198.             parse var argum '([' bd ',' (basereg) rest
  1199.  
  1200.             if substr(rest,1,1)=']' then
  1201.                 do
  1202.                     postidx=4
  1203.                     parse var rest '],' reg ',' od ')'
  1204.                 end
  1205.             else
  1206.                 do
  1207.                     postidx=0
  1208.                     parse var rest ',' reg '],' od ')'
  1209.                 end
  1210.             parse var reg reg '.' idxsize '*' multi
  1211.             'void' bd
  1212.             if rc~=0 then
  1213.                 do
  1214.                     'print "Bad integer !\0a"'
  1215.                     return -1
  1216.                 end
  1217.             bd=result
  1218.             if basereg='PC' then bd=bd-pc+extwrd*2-4
  1219.             'void' od
  1220.             if rc~=0 then
  1221.                 do
  1222.                     'print "Bad integer !\0a"'
  1223.                     return -1
  1224.                 end
  1225.             od=result
  1226.  
  1227.             if (idxsize='W') | (idxsize='') then idxsize=0
  1228.             else if idxsize='L' then idxsize=1
  1229.             else
  1230.                 do
  1231.                     'print "Bad index size specifier !\0a"'
  1232.                     return -1
  1233.                 end
  1234.  
  1235.             idxreg=regbits(reg)
  1236.             if idxreg=-1 then return -1
  1237.             if substr(reg,1,1)='A' then idxdata=1
  1238.             else idxdata=0
  1239.  
  1240.             if (multi='') | (multi='1') then multi=0
  1241.             else if multi='2' then multi=1
  1242.             else if multi='4' then multi=2
  1243.             else if multi='8' then multi=3
  1244.             else
  1245.                 do
  1246.                     'print "Bad index scale !\0a"'
  1247.                     return -1
  1248.                 end
  1249.  
  1250.             if (od>32767) | (od<-32768) then postidx=postidx+3
  1251.             else postidx=postidx+2
  1252.  
  1253.             if (bd>32767) | (bd<-32768) then baseidx=3
  1254.             else baseidx=2
  1255.  
  1256.             call PushWord idxdata*32768+idxreg*4096+idxsize*2048+multi*512+256+baseidx*16+postidx
  1257.  
  1258.             if (bd>32767) | (bd<-32768) then call PushLong bd
  1259.             else call PushWord bd
  1260.  
  1261.             if (od>32767) | (od<-32768) then call PushLong od
  1262.             else call PushWord od
  1263.  
  1264.             return 0
  1265.         end
  1266.     else
  1267.         do
  1268.             parse var argum '(' bd ',' (basereg) ',' reg ')'
  1269.  
  1270.             parse var reg reg '.' idxsize '*' multi
  1271.             'void' bd
  1272.             if rc~=0 then
  1273.                 do
  1274.                     'print "Bad integer !\0a"'
  1275.                     return -1
  1276.                 end
  1277.             bd=result
  1278.             if basereg='PC' then bd=bd-pc+extwrd*2-4
  1279.  
  1280.             if (idxsize='W') | (idxsize='') then idxsize=0
  1281.             else if idxsize='L' then idxsize=1
  1282.             else
  1283.                 do
  1284.                     'print "Bad index size specifier !\0a"'
  1285.                     return -1
  1286.                 end
  1287.  
  1288.             idxreg=regbits(reg)
  1289.             if idxreg=-1 then return -1
  1290.             if substr(reg,1,1)='A' then idxdata=1
  1291.             else idxdata=0
  1292.  
  1293.             if (multi='') | (multi='1') then multi=0
  1294.             else if multi='2' then multi=1
  1295.             else if multi='4' then multi=2
  1296.             else if multi='8' then multi=3
  1297.             else
  1298.                 do
  1299.                     'print "Bad index scale !\0a"'
  1300.                     return -1
  1301.                 end
  1302.  
  1303.             if (bd>127) | (bd<-128) then
  1304.                 do
  1305.                     last9=256+32
  1306.                     if (bd>32767) | (bd<-32768) then
  1307.                         do
  1308.                             last9=last9+16
  1309.                         end
  1310.                 end
  1311.             else last9=bd
  1312.  
  1313.             call PushWord idxdata*32768+idxreg*4096+idxsize*2048+multi*512+last9
  1314.  
  1315.             if (bd>127) | (bd<-128)then
  1316.                 do
  1317.                     if (bd>32767) | (bd<-32768) then call PushLong bd
  1318.                     else call PushWord bd
  1319.                 end
  1320.             return 0
  1321.         end
  1322.  
  1323.  
  1324. /*-------------------------------*/
  1325. /* Split argument in two parts    */
  1326. /* source and destination            */
  1327. /*                                            */
  1328. /* Input   : argument                */
  1329. /* Uses    :                            */
  1330. /* Changes : source dest            */
  1331. /* Returns :                            */
  1332. /*-------------------------------*/
  1333.  
  1334. SplitArgs: procedure expose source dest
  1335. parse arg arg
  1336.  
  1337.     parse var arg lsrc '(' source ')' rsrc ',' dest
  1338.     if source='' then
  1339.         do
  1340.             parse var arg source ',' dest
  1341.         end
  1342.     else if dest='' then
  1343.         do
  1344.             parse var arg source ',' dest
  1345.         end
  1346.     else source=lsrc'('source')'rsrc
  1347.     return
  1348.  
  1349.  
  1350. /*-------------------------------------*/
  1351. /* Convert register list to bit string    */
  1352. /*                                                    */
  1353. /* Input   : register list                    */
  1354. /* Uses    :                                    */
  1355. /* Changes :                                     */
  1356. /* Returns : bit string or -1 if error    */
  1357. /*-------------------------------------*/
  1358.  
  1359. RegListBits: procedure
  1360. parse arg list
  1361.  
  1362.     bits='0000000000000000'
  1363.     regs='D0D1D2D3D4D5D6D7A0A1A2A3A4A5A6A7'
  1364.     rest=list
  1365.     do until rest=''
  1366.         parse var rest one '/' rest
  1367.         parse var one left '-' right
  1368.         l=pos(left,regs)
  1369.         if l=0 then
  1370.             do
  1371.                 'print "Bad register !\0a"'
  1372.                 return -1
  1373.             end
  1374.         l=(l-1)/2+1
  1375.         if right='' then
  1376.             bits=overlay('1',bits,l,1)
  1377.         else
  1378.             do
  1379.                 r=pos(right,regs)
  1380.                 if r=0 then
  1381.                     do
  1382.                         'print "Bad register !\0a"'
  1383.                         return -1
  1384.                     end
  1385.                 r=(r-1)/2+1
  1386.                 if ((l<=8) & (r>8)) | ((l>8) & (r<=8)) then
  1387.                     do
  1388.                         'print "Bad register pair !\0a"'
  1389.                         return -1
  1390.                     end
  1391.                 do i=l to r
  1392.                     bits=overlay('1',bits,i,1)
  1393.                 end
  1394.             end
  1395.     end
  1396.     return bits
  1397.  
  1398.  
  1399. /*----------------------------*/
  1400. /* Convert integer to a byte    */
  1401. /*                                        */
  1402. /* Input   : integer                */
  1403. /* Uses    :                        */
  1404. /* Changes :                         */
  1405. /* Returns : byte                    */
  1406. /*----------------------------*/
  1407.  
  1408. MakeByte: procedure
  1409. parse arg int
  1410.  
  1411.     'void' int'&255'
  1412.     return result
  1413.  
  1414.  
  1415. /*----------------------------*/
  1416. /* Convert integer to a word    */
  1417. /*                                        */
  1418. /* Input   : integer                */
  1419. /* Uses    :                        */
  1420. /* Changes :                         */
  1421. /* Returns : word                    */
  1422. /*----------------------------*/
  1423.  
  1424. MakeWord: procedure
  1425. parse arg int
  1426.  
  1427.     'void' int'&65535'
  1428.     return result
  1429.  
  1430.  
  1431.